home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Environments / Clean 1.2.4 / MacInterface / events.icl < prev    next >
Encoding:
Modula Implementation  |  1996-01-31  |  5.0 KB  |  181 lines  |  [TEXT/3PRM]
  1. implementation module events;
  2.  
  3. import mac_types;
  4. import StdInt;
  5.  
  6. //    Event masks
  7.  
  8. MDownMask    :== 2;
  9. MUpMask     :== 4;
  10. KeyDownMask :== 8;
  11. KeyUpMask    :== 16;
  12. AutoKeyMask :== 2;
  13. UpdateMask    :== 64;
  14. DiskMask    :== 128;
  15. ActivMask    :== 256;
  16. NetworkMask :== 1024;
  17. DriverMask    :== 2048;
  18. OsMask        :== -32768;
  19.  
  20. //    Device masks
  21.  
  22. MouseMask        :== 6;        // MouseDown | MouseUp
  23. KeyboardMask    :== 56;        // KeyDown     | KeyUp | AutoKey
  24.  
  25. //    Event codes
  26.  
  27. NullEvent        :== 0;
  28. MouseDownEvent    :== 1;
  29. MouseUpEvent    :== 2;
  30. KeyDownEvent    :== 3;
  31. KeyUpEvent        :== 4;
  32. AutoKeyEvent    :== 5;
  33. UpdateEvent     :== 6;
  34. DiskEvent        :== 7;
  35. ActivateEvent    :== 8;
  36. NetworkEvent    :== 10;
  37. DriverEvent     :== 11;
  38. OsEvent            :== 15;
  39. HighLevelEvent    :== 23;
  40.  
  41. //    Flags for suspend and resume events
  42.  
  43. ResumeFlag                :== 1;
  44. ConvertClipboardFlag    :== 2;
  45.  
  46. //    Message codes for operating-system events
  47.  
  48. SuspendResumeMessage    :== 1;        // $01
  49. MouseMovedMessage        :== 250;    // $FA
  50.  
  51. GetNextEvent :: !Int !Toolbox -> (!Bool,!Int,!Int,!Int,!Int,!Int,!Int,!Toolbox);
  52. GetNextEvent eventMask t
  53. =    (b,what,message,when,(position<<16)>>16,position>>16,modifiers,0);
  54. {
  55.     (b,what,message,when,position,modifiers)= GetNextEvent2 eventMask t;
  56. }
  57.  
  58. GetNextEvent2 :: !Int !Toolbox -> (!Bool,!Int,!Int,!Int,!Int,!Int);
  59. GetNextEvent2 eventMask t
  60. = code (eventMask=R18W,t=O4U)(b=D5,what=D4,message=D3,when=D2,position=D1,modifiers=D0){
  61.     instruction 0xA970            ||    _GetNextEvent
  62.     instruction 0x7A01            ||    moveq    #1,d5
  63.     instruction 0xCA1F            ||    and.b    (sp)+,d5
  64.     instruction 0x4485            ||    neg.l    d5
  65.     instruction 0x381F            ||    move    (sp)+,d4
  66.     instruction 0x48C4            ||    ext.l    d4
  67.     instruction 0x261F            ||    move.l    (sp)+,d3
  68.     instruction 0x241F            ||    move.l    (sp)+,d2
  69.     instruction 0x221F            ||    move.l    (sp)+,d1
  70.     instruction 0x301F            ||    move    (sp)+,d0
  71.     instruction 0x48C0            ||    ext.l    d0
  72. };
  73.  
  74. EventAvail :: !Int !Toolbox -> (!Bool,!Int,!Int,!Int,!Int,!Int,!Int,!Toolbox);
  75. EventAvail eventMask t
  76. =    (b,what,message,when,(position<<16)>>16,position>>16,modifiers,0);
  77. {
  78.     (b,what,message,when,position,modifiers)= EventAvail2 eventMask t;
  79. }
  80.  
  81. EventAvail2 :: !Int !Toolbox -> (!Bool,!Int,!Int,!Int,!Int,!Int);
  82. EventAvail2 eventMask t = code (eventMask=R18W,t=O4U)(b=D5,what=D4,message=D3,when=D2,position=D1,modifiers=D0){
  83.     instruction 0xA971
  84.     instruction 0x7A01            ||    moveq    #1,d5
  85.     instruction 0xCA1F            ||    and.b    (sp)+,d5
  86.     instruction 0x4485            ||    neg.l    d5
  87.     instruction 0x381F            ||    move    (sp)+,d4
  88.     instruction 0x48C4            ||    ext.l    d4
  89.     instruction 0x261F            ||    move.l    (sp)+,d3
  90.     instruction 0x241F            ||    move.l    (sp)+,d2
  91.     instruction 0x221F            ||    move.l    (sp)+,d1
  92.     instruction 0x301F            ||    move    (sp)+,d0
  93.     instruction 0x48C0            ||    ext.l    d0
  94. };
  95.  
  96. WaitNextEvent :: !Int !Int !RgnHandle !Toolbox -> (!Bool,!Int,!Int,!Int,!Int,!Int,!Int,!Toolbox);
  97. WaitNextEvent eventMask sleep mouseRgn t
  98. =    (b,what,message,when,(position<<16)>>16,position>>16,modifiers,0);
  99. {
  100.     (b,what,message,when,position,modifiers)= WaitNextEvent2 eventMask sleep mouseRgn t;
  101. }
  102.  
  103. WaitNextEvent2 :: !Int !Int !RgnHandle !Toolbox -> (!Bool,!Int,!Int,!Int,!Int,!Int);
  104. WaitNextEvent2 eventMask sleep mouseRgn t
  105. = code (eventMask=R18W,sleep=O4L,mouseRgn=L,t=U)(b=D5,what=D4,message=D3,when=D2,position=D1,modifiers=D0){
  106.     instruction 0xA860
  107.     instruction 0x7A01            ||    moveq    #1,d5
  108.     instruction 0xCA1F            ||    and.b    (sp)+,d5
  109.     instruction 0x4485            ||    neg.l    d5
  110.     instruction 0x381F            ||    move    (sp)+,d4
  111.     instruction 0x48C4            ||    ext.l    d4
  112.     instruction 0x261F            ||    move.l    (sp)+,d3
  113.     instruction 0x241F            ||    move.l    (sp)+,d2
  114.     instruction 0x221F            ||    move.l    (sp)+,d1
  115.     instruction 0x301F            ||    move    (sp)+,d0
  116.     instruction 0x48C0            ||    ext.l    d0
  117. };
  118.  
  119. TickCount :: !Toolbox -> (!Int,!Toolbox);
  120. TickCount t = code (t=R4D0)(r=L,z=Z){
  121.     instruction 0xA975
  122. };
  123.  
  124. GetMouse :: !Toolbox -> (!Int,!Int,!Toolbox);
  125. GetMouse tb
  126. =    (h,v,tb1);
  127.     where {
  128.         (v,h,tb1) =: GetMouse1 tb;
  129.     };
  130.     
  131. GetMouse1 :: !Toolbox -> (!Int,!Int,!Toolbox);
  132. GetMouse1 t = code (t=R4O0U)(v=W,h=W,z=Z){
  133.     instruction 0xA972
  134. };
  135.  
  136. Button :: !Toolbox -> (!Bool,!Toolbox);
  137. Button t = code (t=R2D0)(b=D1,z=Z){
  138.     instruction 0xA974
  139.     instruction 0x7000            ||    moveq    #0,d0
  140.     instruction 0x101F            ||    move.b    (sp)+,d0
  141.     instruction 0x4440            ||    neg.w    d0
  142.     instruction 0x48C0            ||    ext.l    d0
  143.     instruction 0x2200            ||    move.l    d0,d1
  144. };
  145.  
  146. StillDown :: !Toolbox -> (!Bool,!Toolbox);
  147. StillDown t = code (t=R2D0)(b=D1,z=Z){
  148.     instruction 0xA973
  149.     instruction 0x7000            ||    moveq    #0,d0
  150.     instruction 0x101F            ||    move.b    (sp)+,d0
  151.     instruction 0x4440            ||    neg.w    d0
  152.     instruction 0x48C0            ||    ext.l    d0
  153.     instruction 0x2200            ||    move.l    d0,d1
  154. };
  155.  
  156. WaitMouseUp :: !Toolbox -> (!Bool,!Toolbox);
  157. WaitMouseUp t = code (t=R2U)(b=D1,z=Z){
  158.     instruction 0xA977
  159.     instruction 0x7000            ||    moveq    #0,d0
  160.     instruction 0x101F            ||    move.b    (sp)+,d0
  161.     instruction 0x4440            ||    neg.w    d0
  162.     instruction 0x48C0            ||    ext.l    d0
  163.     instruction 0x2200            ||    move.l    d0,d1
  164. };
  165.  
  166. GetKeys :: !Toolbox -> (!Int,!Int,!Int,!Int,!Toolbox);
  167. GetKeys t =code (t=R16O0U)(k0=L,k1=L,k2=L,k3=L,z=Z){
  168.     instruction 0xA976
  169. };
  170.  
  171. HasWaitNextEvent :: !Toolbox -> (!Bool,!Toolbox);
  172. HasWaitNextEvent tb = (HasWaitNextEvent1 tb, NewToolbox);
  173.  
  174. HasWaitNextEvent1 :: !Toolbox -> Bool;
  175. HasWaitNextEvent1 t = code {
  176.     pop_b 1
  177. .d 0 0
  178.     jsr    _has_wait_next_event
  179. .o 0 1 b
  180. };
  181.